home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / f2c-stab.9 / f2c-stab / f2c-stabs / columnout.stk next >
Encoding:
Text File  |  1996-03-31  |  4.4 KB  |  100 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; columnout - Library for outputing data in columns.
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;;;
  5. ;;; Copyright (c) 1996 Harvey J. Stein <abel@netvision.net.il>, and
  6. ;;; eventually <hjstein@netvision.net.il>
  7. ;;; All Rights Reserved.
  8. ;;; 
  9. ;;; This package is covered by the GNU GPL.  You can freely use and
  10. ;;; distribute it as long as it stays under the GNU GPL, and as long as
  11. ;;; you distribute all the corresponding source code, and as long as this
  12. ;;; message and the above copyright notice remains.
  13.  
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15. ;;; Columns of output
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. (define (write-list-in-cols
  18.      lst item-format-fcn group-preamble line-preamble separator final-separator ncols)
  19.   "Writes out LST in columns using specified ITEM-FORMAT-FCN on each
  20. item.  The output is proceeded by GROUP-PREAMBLE.  Each line is
  21. proceeded by LINE-PREAMBLE.  Items are separated by SEPARATOR.  The
  22. last item is followed by FINAL-SEPARATOR.  NCOLS of items are placed
  23. on each line."
  24.   (define (write-list-in-cols-aux lst list-len count)
  25.     (cond ((= list-len 0))
  26.       (else
  27.        (cond ((= (modulo count ncols) 0)
  28.           (format #t "\n")
  29.           (format #t "~a" line-preamble)))
  30.        (item-format-fcn (car lst))
  31.        (if (= list-len 1)
  32.            (format #t "~a" final-separator)
  33.          (format #t "~a" separator))
  34.        (write-list-in-cols-aux (cdr lst) (- list-len 1) (+ count 1)))))
  35.   (format #t "~a" group-preamble)
  36.   (write-list-in-cols-aux lst (length lst) 0))
  37.  
  38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39. ;;; Output which doesn't exceed a certain number of columns per line.
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41. (define (format-multiline col-wid line-cont-pref s . args)
  42.   "Returns (format #f s args), except will break lines before arguments if
  43. the line gets too long.  Too long is > COL-WID characters.  Whenever a line
  44. gets broken, LINE-CONT-PREF is prepended to the next line."
  45.   (define (format-aux chars flist alist)
  46.     (let ((next-hunk (if (or (null? alist) (null? flist))
  47.              ""
  48.              (format #f (car flist) (car alist)))))
  49.       (set! chars (+ chars (string-length next-hunk)))
  50.       (cond ((> chars col-wid)
  51.              (set! chars (+ (string-length line-cont-pref) (string-length next-hunk)))
  52.              (set! next-hunk (string-append "\n" line-cont-pref next-hunk))))
  53.       (if (or (null? alist) (null? flist))
  54.       (list next-hunk)
  55.       (cons next-hunk
  56.         (format-aux chars (cdr flist) (cdr alist))))))
  57.  
  58.   (let* ((arg-len (length args))
  59.          (matcher (string->regexp
  60.                    (string-append
  61.                     "^([^~]*)"
  62.                     (apply string-append (vector->list
  63.                                         (make-vector arg-len
  64.                                                      "(~.?[^~]*)")))
  65.                     "$")))
  66.          (match-list (matcher s))
  67.      (flist (map (lambda (x) (apply substring s x))
  68.              (cdr match-list))))
  69.     (apply string-append
  70.        (cons (car flist)
  71.          (format-aux (string-length (car flist))
  72.                  (cdr flist) args)))))
  73.  
  74.  
  75. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  76. ;;; Writing a list of items in fortran compatible format.
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. (define (write-ftn-list lst write-fcn ncols)
  79.   "Writes out LST of items in a FORTRAN format (lines start with
  80. a continuation character in the proper column, items are separated by
  81. commas, etc., NCOLS items per row."
  82.   (write-list-in-cols lst write-fcn "" "     + " "," "" ncols))
  83.  
  84. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  85. ;;; Output with fortran line breaks if necessary.
  86. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87. (define (format-fortran p s . args)
  88.   "Returns (format p s args), except will break lines at arguments if
  89. the line gets too long.  Too long is > 72 characters.  Whenever a line
  90. gets broken, "      +      " is prepended to the next line."
  91.   (apply format-fortran-w-cont p s "     +      " args))
  92.  
  93. (define (format-fortran-w-cont p s cont . args)
  94.   "Returns (format p s args), except will break lines at arguments if
  95. the line gets too long.  Too long is > 72 characters.  Whenever a line
  96. gets broken, "      +      " is prepended to the next line."
  97.   (format p "~a" (apply format-multiline 72 cont s args)))
  98.  
  99. (provide "columnout")
  100.